home *** CD-ROM | disk | FTP | other *** search
/ Young Minds / Young Minds Interactive CD-ROM.ISO / dungeon / dgame.f < prev    next >
Encoding:
Text File  |  1987-09-16  |  4.4 KB  |  216 lines
  1. C GAME- MAIN COMMAND LOOP FOR DUNGEON
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  9.     SUBROUTINE GAME
  10.     IMPLICIT INTEGER (A-Z)
  11.     LOGICAL RMDESC,VAPPLI,RAPPLI,AAPPLI
  12.     LOGICAL F,PARSE,FINDXT,XVEHIC,LIT
  13.     CHARACTER SECHO(4)
  14.     CHARACTER GDTSTR(3)
  15. #include "parser.h"
  16. #include "gamestate.h"
  17. #include "state.h"
  18. #include "io.h"
  19. #include "rooms.h"
  20. #include "rindex.h"
  21. #include "objects.h"
  22. #include "oflags.h"
  23. #include "oindex.h"
  24. #include "advers.h"
  25. #include "verbs.h"
  26. #include "flags.h"
  27. C
  28. C FUNCTIONS AND DATA
  29. C
  30.     DATA SECHO/'E','C','H','O'/
  31.     DATA GDTSTR/'G','D','T'/
  32. C GAME, PAGE 2
  33. C
  34. C START UP, DESCRIBE CURRENT LOCATION.
  35. C
  36.     CALL RSPEAK(1)
  37. C                        !WELCOME ABOARD.
  38.     F=RMDESC(3)
  39. C                        !START GAME.
  40. C
  41. C NOW LOOP, READING AND EXECUTING COMMANDS.
  42. C
  43. 100    WINNER=PLAYER
  44. C                        !PLAYER MOVING.
  45.     TELFLG=.FALSE.
  46. C                        !ASSUME NOTHING TOLD.
  47.     IF(PRSCON.LE.1) CALL RDLINE(INBUF,INLNT,1)
  48. C
  49.     DO 150 I=1,3
  50. C                        !CALL ON GDT?
  51.       IF(INBUF(I+PRSCON-1).NE.GDTSTR(I)) GO TO 200
  52. 150    CONTINUE
  53.     CALL GDT
  54. C                        !YES, INVOKE.
  55.     GO TO 100
  56. C                        !ONWARD.
  57. C
  58. 200    MOVES=MOVES+1
  59.     PRSWON=PARSE(INBUF,INLNT,.TRUE.)
  60.     IF(.NOT.PRSWON) GO TO 400
  61. C                        !PARSE LOSES?
  62.     IF(XVEHIC(1)) GO TO 400
  63. C                        !VEHICLE HANDLE?
  64. C
  65.     IF(PRSA.EQ.TELLW) GO TO 2000
  66. C                        !TELL?
  67. 300    IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 900
  68.     IF(.NOT.VAPPLI(PRSA)) GO TO 400
  69. C                        !VERB OK?
  70. 350    IF(.NOT.ECHOF.AND.(HERE.EQ.ECHOR)) GO TO 1000
  71.     F=RAPPLI(RACTIO(HERE))
  72. C
  73. 400    CALL XENDMV(TELFLG)
  74. C                        !DO END OF MOVE.
  75.     IF(.NOT.LIT(HERE)) PRSCON=1
  76.     GO TO 100
  77. C
  78. 900    CALL VALUAC(VALUA)
  79.     GO TO 350
  80. C GAME, PAGE 3
  81. C
  82. C SPECIAL CASE-- ECHO ROOM.
  83. C IF INPUT IS NOT 'ECHO' OR A DIRECTION, JUST ECHO.
  84. C
  85. 1000    CALL RDLINE(INBUF,INLNT,0)
  86.     MOVES=MOVES+1
  87. C                        !CHARGE FOR MOVES.
  88.     DO 1100 I=1,4
  89. C                        !INPUT = ECHO?
  90.       IF(INBUF(I).NE.SECHO(I)) GO TO 1300
  91. 1100    CONTINUE
  92. C
  93. C   Note: the following DO loop was changed from DO 1200 I=5,78
  94. C     The change was necessary because the RDLINE function was changed,
  95. C      and no longer provides a 78 character buffer padded with blanks.
  96. C
  97.     DO 1200 I=5,INLNT
  98.       IF(INBUF(I).NE.' ') GO TO 1300
  99. 1200    CONTINUE
  100. C
  101.     CALL RSPEAK(571)
  102. C                        !KILL THE ECHO.
  103.     ECHOF=.TRUE.
  104.     OFLAG2(BAR)=and(OFLAG2(BAR), not(SCRDBT))
  105.     PRSWON=.TRUE.
  106. C                        !FAKE OUT PARSER.
  107.     PRSCON=1
  108. C                        !FORCE NEW INPUT.
  109.     GO TO 400
  110. C
  111. 1300    PRSWON=PARSE(INBUF,INLNT,.FALSE.)
  112.     IF(.NOT.PRSWON .OR. (PRSA.NE.WALKW))
  113. &        GO TO 1400
  114.     IF(FINDXT(PRSO,HERE)) GO TO 300
  115. C                        !VALID EXIT?
  116. C
  117. #ifdef PDP
  118. 1400    call outstr(INLINE, INLNT)
  119. #else
  120. 1400    WRITE(OUTCH,1410) (INBUF(J),J=1,INLNT)
  121. 1410    FORMAT(1X,78A1)
  122. #endif PDP
  123.     TELFLG=.TRUE.
  124. C                        !INDICATE OUTPUT.
  125.     GO TO 1000
  126. C                        !MORE ECHO ROOM.
  127. C GAME, PAGE 4
  128. C
  129. C SPECIAL CASE-- TELL <ACTOR>, NEW COMMAND
  130. C NOTE THAT WE CANNOT BE IN THE ECHO ROOM.
  131. C
  132. 2000    IF(and(OFLAG2(PRSO),ACTRBT).NE.0) GO TO 2100
  133.     CALL RSPEAK(602)
  134. C                        !CANT DO IT.
  135.     GO TO 350
  136. C                        !VAPPLI SUCCEEDS.
  137. C
  138. 2100    WINNER=OACTOR(PRSO)
  139. C                        !NEW PLAYER.
  140.     HERE=AROOM(WINNER)
  141. C                        !NEW LOCATION.
  142.     IF(PRSCON.LE.1) GO TO 2700
  143. C                        !ANY INPUT?
  144.     IF(PARSE(INBUF,INLNT,.TRUE.)) GO TO 2150
  145. 2700    I=341
  146. C                        !FAILS.
  147.     IF(TELFLG) I=604
  148. C                        !GIVE RESPONSE.
  149.     CALL RSPEAK(I)
  150. 2600    WINNER=PLAYER
  151. C                        !RESTORE STATE.
  152.     HERE=AROOM(WINNER)
  153.     GO TO 350
  154. C
  155. 2150    IF(AAPPLI(AACTIO(WINNER))) GO TO 2400
  156. C                        !ACTOR HANDLE?
  157.     IF(XVEHIC(1)) GO TO 2400
  158. C                        !VEHICLE HANDLE?
  159.     IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 2900
  160.     IF(.NOT.VAPPLI(PRSA)) GO TO 2400
  161. C                        !VERB HANDLE?
  162. 2350    F=RAPPLI(RACTIO(HERE))
  163. C
  164. 2400    CALL XENDMV(TELFLG)
  165. C                        !DO END OF MOVE.
  166.     GO TO 2600
  167. C                        !DONE.
  168. C
  169. 2900    CALL VALUAC(VALUA)
  170. C                        !ALL OR VALUABLES.
  171.     GO TO 350
  172. C
  173.     END
  174. C XENDMV-    EXECUTE END OF MOVE FUNCTIONS.
  175. C
  176. C DECLARATIONS
  177. C
  178.     SUBROUTINE XENDMV(FLAG)
  179.     IMPLICIT INTEGER(A-Z)
  180.     LOGICAL F,CLOCKD,FLAG,XVEHIC
  181. #include "parser.h"
  182. #include "villians.h"
  183. C
  184.     IF(.NOT.FLAG) CALL RSPEAK(341)
  185. C                        !DEFAULT REMARK.
  186.     IF(THFACT) CALL THIEFD
  187. C                        !THIEF DEMON.
  188.     IF(PRSWON) CALL FIGHTD
  189. C                        !FIGHT DEMON.
  190.     IF(SWDACT) CALL SWORDD
  191. C                        !SWORD DEMON.
  192.     IF(PRSWON) F=CLOCKD(X)
  193. C                        !CLOCK DEMON.
  194.     IF(PRSWON) F=XVEHIC(2)
  195. C                        !VEHICLE READOUT.
  196.     RETURN
  197.     END
  198. C XVEHIC- EXECUTE VEHICLE FUNCTION
  199. C
  200. C DECLARATIONS
  201. C
  202.     LOGICAL FUNCTION XVEHIC(N)
  203.     IMPLICIT INTEGER(A-Z)
  204.     LOGICAL OAPPLI
  205. #include "gamestate.h"
  206. #include "objects.h"
  207. #include "advers.h"
  208. C
  209.     XVEHIC=.FALSE.
  210. C                        !ASSUME LOSES.
  211.     AV=AVEHIC(WINNER)
  212. C                        !GET VEHICLE.
  213.     IF(AV.NE.0) XVEHIC=OAPPLI(OACTIO(AV),N)
  214.     RETURN
  215.     END
  216.